home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / ListManager < prev    next >
Encoding:
Text File  |  1994-11-06  |  4.3 KB  |  212 lines  |  [TEXT/MSET]
  1.  \ 28Oct94 dbh updated to 2.5 syntax 
  2.  
  3. (*
  4.  
  5. The ListManager class is intended for subclassing. See class list-col for
  6. an example.
  7.  
  8. *)
  9.  
  10. \ dataBounds and Cell are a couple of special classes for Lists
  11.  
  12. :class dataBounds super{ object }
  13.     record{
  14.     longword junk    \ not used??
  15.     int #rows
  16.     int #cols
  17.     }
  18.  
  19. :m put#rows: ( n -- )
  20.     put: #rows ;m
  21.  
  22. :m put#cols: ( n -- )
  23.     put: #cols ;m
  24.  
  25. :m get#rows: ( -- n )
  26.     get: #rows ;m
  27.  
  28. :m get#cols: ( -- n )
  29.     get: #cols ;m
  30.  
  31. :m put:  ( #rows #cols -- )
  32.     put#cols: self  put#rows: self ;m
  33.  
  34. ;class
  35.  
  36.  
  37. :class cell super{ object }
  38.     record{
  39.     int row#
  40.     int col#
  41.     }
  42.  
  43. :m getrow#: ( -- n )
  44.     get: row# ;m
  45.  
  46. :m getcol#: ( -- n )
  47.     get: col# ;m
  48.  
  49. :m putrow#: ( n -- )
  50.     put: row# ;m
  51.  
  52. :m putcol#: ( n -- )
  53.     put: col# ;m
  54.  
  55. :m put:  ( row# col# -- )
  56.     putcol#: self  putrow#: self ;m
  57.  
  58. :m cell: ( row# col# -- cell ) \ leaves the cell's contents, as a point, on the stack
  59.     put: self
  60.     addr: self @ ;m
  61.  
  62. ;class
  63.  
  64.  
  65. :class ListManager super{ nullSelect font }
  66.     handle ListHandle
  67.     ptr thewptr
  68.     bool scrollHoriz
  69.     bool scrollVert
  70.     dataBounds theBounds    \ for LNew call
  71.     rect+ rView        \ for LNew call
  72.     var MaxDataLen    \ maximum byte length for the text in a cell
  73.     handle dataBuf    \ temporary storage needed by LGetCell call
  74.     int dataLen        \ temporary storage needed by LGetCell call
  75.     cell theCell    \ temporary storage needed by LGetSelect call
  76.     x-addr    dbl-click
  77.  
  78. :m setwidth: ( w -- )  \ pixels
  79.     setwidth: rView ;m
  80.  
  81. :m setheight: ( h -- )  \ pipxels
  82.     setheight: rView ;m
  83.  
  84. :m move: ( dx dy -- ) \ only use before new:
  85.     move: rView ;m
  86.  
  87. :m moveto: ( x y -- ) \ only use before new:
  88.     moveto: rView ;m
  89.  
  90. :m #rows:    ( -- n )
  91.     ptr: ListHandle  72  ( offset to dataBounds in record) +
  92.     get#rows: dataBounds ;m
  93.  
  94. :m #cols:    ( -- n )
  95.     ptr: ListHandle  72  ( offset to dataBounds in record) +
  96.     get#cols: dataBounds ;m
  97.  
  98. :m hit?:  \ ( -- b )
  99.     where: theMouse
  100.     get: rview put: temprect
  101.     
  102.     get: scrollVert
  103.     IF 16 0 stretch: temprect THEN    \ stretch width to include the vertical scroll
  104.  
  105.     get: scrollHoriz
  106.     IF 0 16 stretch: temprect THEN    \ stretch width to include the horizontal scroll
  107.  
  108.     temprect PtinRect ;m
  109.     
  110.  
  111. :m new:    { wptr -- }
  112.     getnew: super> font
  113.     wptr put: thewptr
  114.     0                \ space for handle returned from LNew call
  115.     rView
  116.     theBounds
  117.     0                \ cSize, use default cell sizes
  118.     word0            \ theProc, use default
  119.     wptr
  120.     true    tbool    \ drawit
  121.     false    tbool     \ hasgrow
  122.     get: scrollHoriz  tbool
  123.     get: scrollVert   tbool
  124.     call LNew
  125.     put: ListHandle
  126.     get: MaxDataLen new: dataBuf ;m
  127.  
  128. private
  129.     :m LGetSelect:    { row# col# next -- b }    \ raw toolbox call 
  130.         row# col# put: theCell    \ set up theCell for toolbox call
  131.         word0        \ room for result
  132.         next tbool
  133.         theCell
  134.         get: ListHandle call LGetSelect i->l ;m
  135.         
  136.     :m LSetSelect:  { row# col# setIt -- }
  137.         setIt tbool
  138.         row# col# cell: theCell
  139.         get: ListHandle call LSetSelect ;m
  140.  
  141.     :m LActivate: ( flag -- )
  142.         tbool get: ListHandle call LActivate ;m
  143. public
  144.  
  145. :m activate:
  146.     true LActivate: self ;m
  147.     
  148. :m deactivate:
  149.     false LActivate: self ;m
  150.  
  151. :m release:
  152.     release: dataBuf
  153.     get: ListHandle call LDispose ;m
  154.  
  155. :m draw:
  156.     set: super> font
  157.     \ first do a normal LUpdate
  158.     get: thewptr 24 +  @  ( visRgn ) get: ListHandle call LUpdate
  159.     \ then draw a rectangle around the cells
  160.     get: rview put: temprect
  161.     -1 -1 inset: temprect
  162.     call PenNormal
  163.     draw: temprect ;m
  164.  
  165. :m show:    \ will autoscroll to the currently selected cell
  166.     get: ListHandle call LAutoScroll ;m
  167.  
  168. :m select:    ( row# col# -- )
  169.     true LSetSelect: self ;m
  170.  
  171. :m deselect:  ( row# col# -- )
  172.     false LSetSelect: self ;m
  173.  
  174. :m click:
  175.     set: super> font
  176.     word0    \ room for result
  177.     where: theMouse pack    \ pt
  178.     mods: fevent makeint    \ modifiers
  179.     get: ListHandle call LClick
  180.     ( -- b )    \ true if double-click in same cell
  181.     i->l IF exec: dbl-click THEN ;m
  182.  
  183. :m dblclick: ( cfa -- )
  184.     put: dbl-click ;m
  185.  
  186. :m at:    { row# col# -- addr len }
  187.     ptr: dataBuf    \ dataPtr = dest addr
  188.     get: MaxDataLen put: dataLen  dataLen    \ VAR dataLen = requested length
  189.     row# col# cell: theCell
  190.     get: ListHandle call LGetCell
  191.     ptr: dataBuf get: dataLen  ;m  \ will return len = actual length
  192.  
  193. :m to:    { addr len row# col# -- }
  194.     addr        \ dataPtr
  195.     len  get: MaxDataLen min makeint    \ dataLen
  196.     row# col# cell: theCell
  197.     get: ListHandle call LSetCell ;m
  198.  
  199. :m DoDraw: { flag -- }
  200.     flag tbool get: ListHandle call LDoDraw
  201.     flag IF clear: rview update: rview THEN    \ only if turning drawing back on
  202.     ;m
  203.     
  204. ;class
  205.  
  206. endload
  207.  
  208. *** EXAMPLE USE
  209.  
  210. The ListManager class is intended for subclassing. See class list-col for
  211. an example.
  212.